	module mpsgms

	use mpsge


	contains

! KP question. Should all of these routines go into a "ToGAMS" module?

        subroutine testsym
        type (symbol), pointer :: s
	character (len=255) :: rec
        if (.not.associated(idlist)) return

!        write(iogms,'(/a/)') '*      Alert user to undefined sets or parameters which are referenced in the MPSGE model:'
        s => idlist
        do while (associated(s))
          if (s%type.eq.'set') call writegms('$abort','$if not settype '//trim(s%name),'$abort "'//trim(s%name)//' should be a SET."')
          if (s%type.eq.'parameter') then
	  
	    call writegms('$abort','$if not partype '//trim(s%name), '$abort "'//trim(s%name)//' should be a PARAMETER."')
	    write(rec,'(a,i0,1x,a)') '$if not dimension ',s%dim,trim(s%name)
	    call writegms('$abort',rec, '$abort "'//trim(s%name)//' has an inconsistent dimension."')
          end if
          s => s%next
        end do

!        write(iogms,'(//,a)') '*    Alias definitions:'
        s => idlist
        do while (associated(s))
          if (s%type.eq.'set') call writegms('alias','alias ('//trim(s%name)//','//trim(s%name)//'_);',' ')
          s => s%next
        end do


        return
        end subroutine testsym

        subroutine fnecho
        type (field), pointer :: f, fnf
        type (record), pointer :: r
        type (function), pointer :: fn
        type (nest), pointer :: n

        fn => functionlist
        do while (associated(fn))
          r => fn%firstrecord
          fnf => r%firstfield
          if (fnf%label.ne.'$prod') then
            fn => fn%next
            cycle
          end if
          n => fn%inputs
          do while (associated(n))
            if (associated(n%subnests)) then
              call nlist(n%subnests)
            end if
            if (associated(n%elements)) then
              call elist(n%elements)
            end if
            n => n%next
          end do
          fn => fn%next
        end do
        return
        end subroutine fnecho

        subroutine nlist(sn)
        type (nestlist), pointer :: sn, s
        s => sn
        do while (associated(s))
          write(*,'(t15,a)') trim(s%n%ident)
          s => s%next
        end do
        return
        end subroutine nlist

        subroutine elist(el)
        type (netputlist), pointer :: el, e
        character (len=255) :: domain, subdomain
        e => el
        do while (associated(e))
          call writedomain(e%np%d, domain)
          call writedomain(e%np%sd, subdomain)
          write(*,'(t15,a)') trim(e%np%f%data)//' ('//trim(domain)//') ('//trim(subdomain)//')'
          e => e%next
        end do
        return
        end subroutine elist


        subroutine buildmodel
        type (symbol), pointer :: s
        type (function), pointer :: fn
        type (field), pointer :: fnf
	type (record), pointer :: r
        character (len=9) :: vtype(4)=(/'sector   ','commodity','consumer ','auxiliary'/)
        character (len=4) :: prefix(4)=(/'prf_','mkt_','inc_','aux_'/)
        character (len=2048) :: rec
        character (len=255) :: cost, revenue, c0, r0, descript
	character :: sep
        integer :: k, ic

!        write(iogms,'(//a)') 'POSITIVE VARIABLES'
	rec = ' '
        do k=1,4
          s => idlist
          do while (associated(s))
            if (s%type.eq.vtype(k)) then
	      if (rec.ne.' ') call writegms('variable',rec,descript)
              rec = trim(adjustl(s%lines%line%text))
              ic = index(rec,'!')
              if (ic.eq.0) then
	        descript = ' '
              else
	        descript = adjustl(rec(ic+1:))
	        rec = adjustl(rec(1:ic-1))
              end if
            end if
            s => s%next
          end do
        end do
	if (rec.ne.' ') then
	  if (descript.ne.' ') then
	    call writegms('variable',trim(rec),trim(descript)//';')
	  else
	    call writegms('variable',trim(rec)//';',' ')
	  end if
	end if

!        write(iogms,'(//a)') 'EQUATIONS'
	rec = ' '
        do k=1,4
          s => idlist
          do while (associated(s))
            if (s%type.eq.vtype(k)) then
	      if (rec.ne.' ') call writegms('equation',rec,descript)
              rec = adjustl(s%lines%line%text)
              call tab2blank(rec)
              ic = index(rec,'!')
              if (ic.eq.0) then
	        rec = prefix(k)//trim(rec)
		descript = ' '
              else
		descript = '"'//trim(adjustl(rec(ic+1:)))//'"'
	        rec = prefix(k)//adjustl(trim(rec(1:ic-1)))
              end if
            end if
            s => s%next
          end do
        end do
	if (rec.ne.' ') then
	  if (descript.ne.' ') then
	    call writegms('equation',trim(rec),trim(descript)//';')
	  else
	    call writegms('equation',trim(rec)//';',' ')
	  end if
	end if

	rec = 'MODEL '//trim(modelname)//' /'
	sep = ' '
        do k=1,4
          s => idlist
          do while (associated(s))
            if (s%type.eq.vtype(k)) then
	       rec = trim(rec)//sep//prefix(k)//trim(s%lines%line%record%firstfield%identtext)//'.'//trim(s%lines%line%record%firstfield%identtext)
	       sep = ','
	    end if
	    s => s%next
	  end do
	end do
	rec = trim(rec)//'/;'
	call writegms('model',rec,' ')

!        write(iogms,'(//a)') '* Level values'
        do k=1,2
          s => idlist
          do while (associated(s))
            if (s%type.eq.vtype(k)) then
              rec = s%lines%line%text
              call tab2blank(rec)
              ic = index(rec,'!')
              if (ic.gt.0) rec(ic:) = ' '
              ic = index(rec,'(')
              if (ic.gt.0) then
	        call writegms('level',rec(1:ic-1)//'.l'//trim(rec(ic:))//' = 1;',' ')
              else
	        call writegms('level',trim(rec)//'.l = 1;',' ')
              endif
            end if
            s => s%next
          end do
        end do

!        write(iogms,'(//a)') '* Arbitrage conditions:'
        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$prod') then
            fn => fn%next
            cycle
          end if
          call writeparam('p_', fn%inputs%index,fnf%arg,cost)
          call writeparam('c0_',fn%inputs%index,fnf%arg,c0)
          call writeparam('p_', fn%outputs%index,fnf%arg,revenue)
          call writeparam('r0_',fn%outputs%index,fnf%arg,r0)
	  call writegms('profit','prf_'//trim(fnf%data)//'..',trim(c0)//'*'//trim(cost)//' =G= '//trim(r0)//'*'//trim(revenue)//';')
          fn => fn%next
        end do

!        write(iogms,'(//a)') '* Market clearance conditions:'

        s => idlist
        do while (associated(s))
          if (s%type.eq.'commodity') call writemkt(s)
          s => s%next
        end do

!        write(iogms,'(//a)') '* Income balance conditions:'

	s => idlist
	do while (associated(s))
	  if (s%type.eq.'consumer') call writeinc(s)
	  s => s%next
	end do

!	 write(iogms,'(//a)') '* Auxiliary constraints:'

	fn => functionlist
	do while (associated(fn))
	  r => fn%firstrecord
	  fnf => r%firstfield
	  if (fnf%label.ne.'$constraint') then
	    fn => fn%next
	    cycle 
	  end if
	  call writegms('constraint','aux_'//trim(fnf%data)//'..',' ')
	  do while (associated(r%next))
	    r => r%next
	    if (r%line%text(1:1).eq.'*') cycle
	    if (r%line%text.eq.' ') cycle
	    call writegms('constraint',' ',trim(r%line%text))
	  end do
	  fn => fn%next
	end do

        return
        end subroutine buildmodel


        subroutine writeinc(s)
        type (symbol), pointer :: s
        type (field), pointer :: fnf
        type (function), pointer :: fn, c
        type (nest), pointer :: n
        type (endowmentlist), pointer :: el
        type (netputlist), pointer :: e
	type (taxlist), pointer :: t
        logical :: outputs
        character (len=3) :: prefix
        character (len=255) :: domstr, cident, condtn
	character (len=1024) :: rec
        integer :: ndim, i

!       Determine whether there is a conditional clause attached to the consumer declaration:

        if (s%lines%line%record%firstfield%condtn.ne.' ') then
          condtn = '$'//trim(s%lines%line%record%firstfield%condtn)//'..'
        else
          condtn = '..'
        end if

!       Generate an array of labels for this consumer:

        call writedomain(s%lines%line%record%firstfield%arg,domstr)

        cident = s%lines%line%record%firstfield%identtext
        if (domstr.eq.' ') then
	  call writegms('income','inc_'//trim(cident)//trim(condtn),' ')
	  rec = trim(cident)//' =e= '
        else
	  call writegms('income','inc_'//trim(cident)//'('//trim(domstr)//')'//trim(condtn),' ')
	  rec = 'inc_'//trim(cident)//'('//trim(domstr)//') =e='
        end if

!	Locate the consumer demand function

        c => functionlist
        do while (associated(c))
          fnf => c%firstrecord%firstfield
          if (fnf%label.ne.'$demand') then
            c => c%next
            cycle
          end if
          if (trim(s%name).ne.trim(fnf%data)) then
            c => c%next
            cycle
          end if
	  exit
	end do

	el => c%endowments
	do while (associated(el))
	  if (associated(el%e%sd)) then
	    call writedomain(el%e%sd, domstr)
	    if (associated(el%e%r)) then
	      rec = trim(rec)//'+sum(('//trim(domstr)//','//trim(el%e%f%data)//'*'//trim(el%e%q%data)//'*'//trim(el%e%r%data)//')'
	    else
	      rec = trim(rec)//'+sum(('//trim(domstr)//','//trim(el%e%f%data)//'*'//trim(el%e%q%data)//')'
	    end if
	  endif
	  el => el%next
	end do

!	Search for taxes which are paid to this consumer:

        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$prod') then
            fn => fn%next
            cycle
          end if
	  outputs = .true.
          prefix = 's_'
          n => fn%outputs
          do while (associated(n))
            e => n%elements
            do while (associated(e))
	      t => e%np%t
	      do while (associated(t))
		if (trim(t%a%identtext).eq.trim(s%name)) then
		  if (rec.ne.' ') then
		    call writegms('income',' ',rec)
		    rec = ' '
		  end if
		  call writetaxrev(e%np,t,s,fn,rec)
		end if
		t => t%next
	      end do
              e => e%next
	    end do

!       Traverse to the next nest in this tree:

            call nextnest(n)

!       When we are done looking at outputs, process the input nest:

            if (.not.associated(n)) then
              if (.not.outputs) exit
              outputs = .false.
              prefix = '-d_'
              n => fn%inputs
            end if
	  end do
	  fn => fn%next
	end do
	rec = trim(rec)//';'
	if (rec.ne.' ')	call writegms('income',' ',rec)

        return
        end subroutine writeinc



        subroutine writemkt(s)
        type (symbol), pointer :: s
        type (field), pointer :: fnf
        type (function), pointer :: fn
        type (nest), pointer :: n
        type (endowmentlist), pointer :: el
        type (netputlist), pointer :: e
        logical :: outputs
        character (len=3) :: prefix
        character (len=255) :: domstr, pident, condtn
	character (len=1024) :: rec
        integer :: ndim, i

!       Determine whether there is a conditional clause attached to the commodity declaration:

        if (s%lines%line%record%firstfield%condtn.ne.' ') then
          condtn = '$'//trim(s%lines%line%record%firstfield%condtn)//'..'
        else
          condtn = '..'
        end if

!       Generate an array of labels for this market:

        call writedomain(s%lines%line%record%firstfield%arg,domstr)

        pident = s%lines%line%record%firstfield%identtext
        if (domstr.eq.' ') then
	  call writegms('market','mkt_'//trim(pident)//trim(condtn),' ')
        else
	  call writegms('market','mkt_'//trim(pident)//'('//trim(domstr)//')'//trim(condtn),' ')
        end if

!       Now loop over the set of production functions:

	rec = ' '
        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$prod') then
            fn => fn%next
            cycle
          end if

!       Next loop through the input and output nests in this function:

          outputs = .true.
          prefix = 's_'
          n => fn%outputs
          do while (associated(n))
            e => n%elements
            do while (associated(e))
              if (associated(e%np%f%ident,s)) call writenetput(e%np,fn,rec)
              e => e%next
            end do

!       Traverse to the next nest in this tree:

            call nextnest(n)

!       When we are done looking at outputs, process the input nest:

            if (.not.associated(n)) then
              if (.not.outputs) exit
              outputs = .false.
              prefix = '-d_'
              n => fn%inputs
            end if
          end do
          fn => fn%next
        end do

!       Next look at the $demand functions:

        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$demand') then
            fn => fn%next
            cycle
          end if

          if (associated(fn%demand%ident,s)) call writefinaldemand(fn,rec)

          el => fn%endowments
          do while (associated(el))

            if (associated(el%e%f%ident,s)) call writeendowment(el%e,fn,rec)
            el => el%next
          end do
          fn => fn%next
        end do
	rec = trim(rec)//' =e= 0;'
	call writegms('market',' ',rec)
	rec = ' '
        return

        end subroutine writemkt


	subroutine writetaxrev(np,t,s,fn,rec)
	character (len=*) :: rec
        type (netput), pointer :: np
        type (symbol), pointer :: s
	type (function), pointer :: c, fn
	type (taxlist), pointer :: t
	type (field), pointer :: fnf
	character (len=255) :: coefficient, activity, taxrate, price, revenue
	character (len=255) :: sumdomain, sumcondtn, condition
	logical :: domainele
	integer :: i

!	id	Domain of the income equation
!	ad	Domain of the referenced tax agent 
!	nd	Domain of the netput to which the tax is applied
!	yd	Domain of the production sector
!	pd	Domain of the applicable market price
!	td	Domain of the tax parameter

        type (domain), pointer :: id, ad, nd, yd, pd, td
        character (len=32) ::  idl(10), adl(10), ndl(10), ydl(10), pdl(10), tdl(10), prefix

	fnf => fn%firstrecord%firstfield

!       Domain for the income being generated:

        id => s%arg
        call domainlabels(id, idl)

!	Domain for the tax agent:

	ad => t%a%arg
        call domainlabels(ad, adl)

!	Domain of the netput

        nd => np%d
	call domainlabels(nd,ndl)

!	Domain of the function:

        yd => fn%firstrecord%firstfield%arg
	call domainlabels(yd,ydl)

!	Domain of the price:

	pd => np%f%arg
	call domainlabels(pd,pdl)

!	Domain for the tax rate:

	td => t%t%arg
	call domainlabels(td,tdl)

!       Initialize the sum, sum condition and outer condition:

        sumdomain = ' '
        sumcondtn = ' '
        condition = ' '

!       Go through each dimension in the income domain:

        do i=1,dimension(id)

!       When the same set appears in the same position in both the income and tax domain
!       we don't need to add anything to the coefficient sum:

          if (idl(i).eq.adl(i)) cycle

!       If the coefficient domain contains a singleton, then a sameas() rule is applied to the
!       outer condition:

          if (quoted(adl(i))) then
            if (condition.eq.' ') then
              condition = 'sameas('//trim(idl(i))//','//trim(adl(i))//')'
            else
              condition = trim(condition)//' and '//'sameas('//trim(idl(i))//','//trim(adl(i))//')'
            endif
            cycle
          end if

!       At this point we know that we have encountered a set in the coefficient domain which
!       does not match the corresponding set in the market domain.  We first must determine
!       whether the coefficient set is in another location within the income domain, and if it
!       does conflict with one of these sets we need to introduce an alias:

          call dchk(adl(i),idl,domainele)
          if (domainele) then
            call setalias(adl(i), tdl)
            call setalias(adl(i), ndl)
            call setalias(adl(i), ydl)
            call setalias(adl(i), pdl)
            adl(i) = trim(adl(i))//'_'
	  end if

!       Create a entry in the coefficient sum for this set:

          if (sumdomain.eq.' ') then
            sumdomain = adl(i)
            sumcondtn = 'sameas('//trim(idl(i))//','//trim(adl(i))//')'
          else
            sumdomain = trim(sumdomain)//','//adl(i)
            sumcondtn = trim(sumcondtn)//' and sameas('//trim(idl(i))//','//trim(adl(i))//')'
          end if

        end do

!       After having processed all the sets which appear in the tax agent domain we need to 
!       examine sets which appear in netput

	if (dimension(nd).gt.0) then
          do i=1,dimension(nd)
            call dchk(ndl(i),adl,domainele)
            if (.not.domainele) then
              call dchk(ndl(i),idl,domainele)
              if (domainele) then
	        call setalias(ndl(i), tdl)
		call setalias(ndl(i), ydl)
		call setalias(ndl(i), pdl)
	        ndl(i) = trim(ndl(i))//'_'
	      end if
              if (sumdomain.eq.' ') then
                sumdomain = ndl(i)
              else
                sumdomain = trim(sumdomain)//','//trim(ndl(i))
              end if
            end if
          end do
        end if

!       Write out the netput function name using the aliased domain list:

        if (np%output) then
          prefix = 's_'
        else
          prefix = 'd_'
        end if
        call writename(coefficient,prefix,        ndl, np%index)
        call writename(activity,   fnf%identtext, ydl,        0)
        call writename(taxrate,    t%t%identtext, tdl,        0)
        call writename(price,      np%f%identtext,pdl,        0)

	revenue = trim(taxrate)//'*'//trim(coefficient)//'*'//trim(activity)//'*'//trim(price)

!       Generate the record:

        if (sumdomain.ne.' ') then
          if (sumcondtn.ne.' ') then
            rec = trim(rec)//'+sum(('//trim(sumdomain)//')$('//trim(sumcondtn)//'),'//trim(revenue)//')'
          else
            if (index(sumdomain,',').eq.0) then
              rec = trim(rec)//'+sum('//trim(sumdomain)//','//trim(revenue)//')'
            else
              rec = trim(rec)//'+sum(('//trim(sumdomain)//'),'//trim(revenue)//')'
            end if
          end if
          if (condition.ne.' ') rec = trim(rec)//'$'//trim(condition)
        else
          if (condition.eq.' ') then
            rec = trim(rec)//trim(revenue)
          else
            rec = trim(rec)//'+('//trim(revenue)//')'//'$('//trim(condition)//')'
          end if
        end if

        return
        end subroutine writetaxrev



        subroutine writenetput(np,fn,rec)
	character (len=*) :: rec
        type (netput), pointer :: np
        type (function), pointer :: fn
        type (domain), pointer :: md, cd, fd, nd
        type (symbol), pointer :: s
        type (field), pointer :: fnf

!!	mdl(i)	Market domain ($commodity declaration)
!!	cdl(i)	Coefficient domain (I: or O: field)
!!	fdl(i)	Function domain ($prod: field)
!!	ndl(i)	Netput domain (union of I: with function domain)


        character (len=32) ::  mdl(10), cdl(10), fdl(10), ndl(10), prefix
        character (len=255) :: sumdomain, sumcondtn, condition, coefficient, activity, quantity
        logical :: domainele
        integer :: i

!       Assign an identifier and domain for the market being generated:

        s => np%f%ident
        md => s%lines%line%record%firstfield%arg
        call domainlabels(md, mdl)

!       Add the function domain the coefficient domain (cd), the function domain (fd) and the netput domain (nd):

        cd => np%f%arg
        fnf => fn%firstrecord%firstfield
        fd => fnf%arg
        nd => np%d

!       Initialize the sum, sum condition and outer condition which will be used in the output to be blank:

        sumdomain = ' '
        sumcondtn = ' '
        condition = ' '

!       Load default values for the coefficient domain, the function domain and the netput domain into 
!       local arrays.  We need to create local versions of these domains in order to be able to define
!       aliases for selected sets:

        call domainlabels(cd,cdl)
        call domainlabels(fd,fdl)
        call domainlabels(nd,ndl)

!       Go through each dimension in the market domain:

        do i=1,dimension(md)

!       When the same set appears in the same position in both the market and netput domains,
!       we don't need to add anything to the coefficient sum:

          if (mdl(i).eq.cdl(i)) cycle

!       If the coefficient domain contains a singleton, then a sameas() rule is applied to the
!       outer condition:

          if (quoted(cdl(i))) then
            if (condition.eq.' ') then
              condition = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            else
              condition = trim(condition)//' and '//'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            endif
            cycle
          end if

!       At this point we know that we have encountered a set in the coefficient domain which
!       does not match the corresponding set in the market domain.  We first must determine
!       whether the coefficient set is in another location within the market domain, and if it
!       does conflict with one of these sets we need to introduce an alias:

          call dchk(cdl(i),mdl,domainele)
          if (domainele) then
            call setalias(cdl(i), ndl)
            call setalias(cdl(i), fdl)
            cdl(i) = trim(cdl(i))//'_'
          end if

!       Create a entry in the coefficient sum for this set:

          if (sumdomain.eq.' ') then
            sumdomain = cdl(i)
            sumcondtn = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          else
            sumdomain = trim(sumdomain)//','//cdl(i)
            sumcondtn = trim(sumcondtn)//' and sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          end if

        end do

!       After having processed all the sets which appear in the coefficient domain we need to 
!       examine sets which appear in the associated function domain:

        if (dimension(fnf%arg).gt.0) then

          do i=1,dimension(fnf%arg)
            call dchk(fdl(i),cdl,domainele)
            if (.not.domainele) then
              call dchk(fdl(i),mdl,domainele)
              if (domainele) fdl(i) = trim(fdl(i))//'_'
              if (sumdomain.eq.' ') then
                sumdomain = fdl(i)
              else
                sumdomain = trim(sumdomain)//','//trim(fdl(i))
              end if
            end if
          end do

        end if

!       Write out the netput function name using the aliased domain list:

        if (np%output) then
          prefix = 's_'
        else
          prefix = '-d_'
        end if
        call writename(coefficient,prefix,ndl,np%index)
        call writename(quantity,'q_',ndl,np%index)

!       Write out the activity level name using the aliased function domain list:

        call writename(activity,fnf%identtext,fdl,0)
	activity = trim(activity)//'*'//trim(quantity)

!       Generate the record:

        if (sumdomain.ne.' ') then
          if (sumcondtn.ne.' ') then
            rec = trim(rec)//'+sum(('//trim(sumdomain)//')$('//trim(sumcondtn)//'),'//trim(coefficient)//'*'//trim(activity)//')'
          else
            if (index(sumdomain,',').eq.0) then
              rec = trim(rec)//'+sum('//trim(sumdomain)//','//trim(coefficient)//'*'//trim(activity)//')'
            else
              rec = trim(rec)//'+sum(('//trim(sumdomain)//'),'//trim(coefficient)//'*'//trim(activity)//')'
            end if
          end if
          if (condition.ne.' ') rec = trim(rec)//'$'//trim(condition)
        else
          if (condition.eq.' ') then
            rec = trim(rec)//trim(coefficient)//'*'//trim(activity)
          else
            rec = trim(rec)//'+('//trim(coefficient)//'*'//trim(activity)//')'//'$('//trim(condition)//')'
          end if
        end if

        return
        end subroutine writenetput

        subroutine writeendowment(e,fn,rec)
	character (len=*) :: rec
        type (endowment), pointer :: e
        type (function), pointer :: fn
        type (field), pointer :: fnf

	type (symbol), pointer :: s
        type (domain), pointer :: md, cd, fd
        character (len=32) ::  mdl(10), cdl(10), fdl(10)
        character (len=255) :: sumdomain, sumcondtn, condition,  endowq
        logical :: domainele
        integer :: i

!       Introduce an entry for endowment e which appears in demand function fn.

!       Begin by locating the market clearance condition in which this appears:

        s => e%f%ident
        md => s%lines%line%record%firstfield%arg
        call domainlabels(md, mdl)

!       Define the coefficient and function domains:

        cd => e%f%arg
        fnf => fn%firstrecord%firstfield
        fd => fnf%arg

!       We are going to produce a summation domain and conditional for this entry:

        sumdomain = ' '
        sumcondtn = ' '
        condition = ' '

!       Load the set labels for the coefficient and the function into local arrays
!       in which aliases can be substituted:

        call domainlabels(cd,cdl)
        call domainlabels(fd,fdl)

!       Examine each set in the market domain:

        do i=1,dimension(md)

!       When the ith argument in the endowment matches the ith argument in the market
!       clearance condtion, nothing needs to be added:

          if (mdl(i).eq.cdl(i)) cycle

!       If we have a quoted singleton in the endowment, we need to add a sameas() to the
!       outer condition:

          if (quoted(cdl(i))) then
            if (condition.eq.' ') then
              condition = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            else
              condition = trim(condition)//' and '//'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            endif
            cycle
          end if

!       Check to see the set which appears in the coefficient domain appears in some other
!       part of the market domain.  If it does, then create an alias:

          call dchk(cdl(i),mdl,domainele)
          if (domainele) then
            call setalias(cdl(i), fdl)
            cdl(i) = trim(cdl(i))//'_'
          end if

!       Create an entry in the summation domain for this set:

          if (sumdomain.eq.' ') then
            sumdomain = cdl(i)
            sumcondtn = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          else
            sumdomain = trim(sumdomain)//','//cdl(i)
            sumcondtn = trim(sumcondtn)//' and sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          end if

        end do

!       Finally, we need to scan elements of the $demand domain to see if they are included
!       in the market domain, in which case we need to apply an alias:

        if (dimension(fnf%arg).gt.0) then
          do i=1,dimension(fnf%arg)
            call dchk(fdl(i),cdl,domainele)
            if (.not.domainele) then
              call dchk(fdl(i),mdl,domainele)
              if (domainele) then
                fdl(i) = trim(fdl(i))//'_'
              endif
              if (sumdomain.eq.' ') then
                sumdomain = fdl(i)
              else
                sumdomain = trim(sumdomain)//','//trim(fdl(i))
              end if
            end if
          end do
        end if

        call writename(endowq,'e_',cdl,e%index)

        if (sumdomain.ne.' ') then
          if (sumcondtn.ne.' ') then
            rec = trim(rec)//'+sum(('//trim(sumdomain)//')$('//trim(sumcondtn)//'),'//trim(endowq)//')'
          else
            if (index(sumdomain,',').eq.0) then
              rec = trim(rec)//'+sum('//trim(sumdomain)//','//trim(endowq)//')'
            else
              rec = trim(rec)//'+sum(('//trim(sumdomain)//'),'//trim(endowq)//')'
            end if
          end if
          if (condition.ne.' ') rec = trim(rec)//'$'//trim(condition)
        else
          if (condition.eq.' ') then
            rec = trim(rec)//' + '//trim(endowq)
          else
            rec = trim(rec)//'+('//trim(endowq)//')'//'$('//trim(condition)//')'
          end if
        end if

        return
        end subroutine writeendowment


        subroutine writefinaldemand(fn,rec)
	character (len=*) :: rec
        type (function), pointer :: fn
        type (domain), pointer :: md, cd, fd
        type (symbol), pointer :: s
        type (field), pointer :: fnf
        character (len=32) ::  mdl(10), cdl(10), fdl(10)
        character (len=255) :: sumdomain, sumcondtn, condition, pident, price, income
        logical :: domainele
        integer :: i

!       Introduce the final demand coefficient corresponding to $demand function fn.

!       Begin by locating the market clearance condition in which this appears:

        s => fn%demand%ident
        fnf => fn%firstrecord%firstfield

        md => s%lines%line%record%firstfield%arg
        call domainlabels(md, mdl)


        cd => fn%demand%arg
        fd => fnf%arg
        sumdomain = ' '
        sumcondtn = ' '
        condition = ' '
        call domainlabels(cd,cdl)
        call domainlabels(fd,fdl)

        do i=1,dimension(md)

!       When the ith argument in the endowment matches the ith argument in the market
!       clearance condtion, nothing needs to be added:

          if (mdl(i).eq.cdl(i)) cycle


!       If we have a quoted singleton in the endowment, we need to add a sameas() to the
!       outer condition:

          if (quoted(cdl(i))) then
            if (condition.eq.' ') then
              condition = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            else
              condition = trim(condition)//' and '//'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
            endif
            cycle
          end if


!       Check to see the set which appears in the coefficient domain appears in someother
!       part of the market domain.  If it does, then create an alias:

          call dchk(cdl(i),mdl,domainele)
          if (domainele) then
            call setalias(cdl(i), fdl)
            cdl(i) = trim(cdl(i))//'_'
          end if

!       Create an entry in the summation domain for this set:

          if (sumdomain.eq.' ') then
            sumdomain = cdl(i)
            sumcondtn = 'sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          else
            sumdomain = trim(sumdomain)//','//cdl(i)
            sumcondtn = trim(sumcondtn)//' and sameas('//trim(mdl(i))//','//trim(cdl(i))//')'
          end if

        end do


!       Finally, we need to scan elements of the $demand domain to see if they are included
!       in the market domain, in which case we need to apply an alias:

        if (dimension(fnf%arg).gt.0) then
          do i=1,dimension(fnf%arg)
            call dchk(fdl(i),cdl,domainele)
            if (.not.domainele) then
              call dchk(fdl(i),mdl,domainele)
              if (domainele) then
                fdl(i) = trim(fdl(i))//'_'
              endif
              if (sumdomain.eq.' ') then
                sumdomain = fdl(i)
              else
                sumdomain = trim(sumdomain)//','//trim(fdl(i))
              end if
            end if
          end do
        end if

        pident = s%lines%line%record%firstfield%identtext
        call writename(price, pident,       cdl,0)
        call writename(income,fnf%identtext,fdl,0)

        if (sumdomain.ne.' ') then
          if (sumcondtn.ne.' ') then
            rec = trim(rec)//'+sum(('//trim(sumdomain)//')$('//trim(sumcondtn)//'),-'//trim(income)//'/'//trim(price)//')'
          else
            if (index(sumdomain,',').eq.0) then
              rec = trim(rec)//'+sum('//trim(sumdomain)//',-'//trim(income)//'/'//trim(price)//')'
            else
              rec = trim(rec)//'+sum(('//trim(sumdomain)//'),-'//trim(income)//'/'//trim(price)//')'
            end if
          end if
          if (condition.ne.' ') rec = trim(rec)//'$'//trim(condition)
        else
          if (condition.eq.' ') then
            rec = trim(rec)//'-'//trim(income)//'/'//trim(price)
          else
            rec = trim(rec)//'-('//trim(income)//'/'//trim(price)//')'//'$('//trim(condition)//')'
          end if
        end if

        return
        end subroutine writefinaldemand

        subroutine dchk(set,dm, domainele)
        logical :: domainele
        character (len=32) ::  set, dm(10)
        integer :: i
        domainele = .false.
        do i=1,10
          if (set.eq.dm(i)) then
            domainele = .true.
            return
          end if
        end do
        return
        end subroutine dchk

        subroutine writename(name,prefix,domain,indx)
        character (len=*) :: name,prefix
        character (len=32) :: domain(10)        
        integer :: i, indx
        name = adjustl(prefix)
        if (indx.gt.0) write(name,'(a,i3.3)') trim(adjustl(prefix)),indx
        if (domain(1).eq.' ') return
        name = trim(name)//'('//adjustl(domain(1))
        do i=2,10
          if (domain(i).eq.' ') then
            name = trim(name)//')'
            return
          endif
          name = trim(name)//','//adjustl(domain(i))
        end do
        name = trim(name)//')'
        return
        end subroutine writename

        subroutine setalias(set,domain)
        character (len=32) ::  set, domain(10)
        integer :: i
        do i=1,10
          if (domain(i).eq.set) domain(i) = trim(set)//'_'
        end do
        return
        end subroutine setalias 

        subroutine functions
        type (field), pointer :: fnf
        type (function), pointer :: fn
        type (nest), pointer :: n
        type (nestlist), pointer :: nl
        type (netputlist), pointer :: e
        type (taxlist), pointer :: tl
	type (endowmentlist), pointer :: el
        character (len=1024) :: rec, qref, pref, element, total, quant, level, cost, endow, domstr, price
        character (len=1) :: prefix
	real :: esub
        logical :: outputs
        integer :: nnest, nassigned

!        write(iogms,'(//a/)') '$sysinclude gams-f'

!        write(iogms,'(//a/)') '*       Benchmark costs and value shares:'


        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$prod') then
            fn => fn%next
            cycle
          end if
          if(log) write(*,fmt) 'Examining: '//trim(fnf%data)
          outputs = .false.
          nnest = 0

          n => fn%inputs
          do while (associated(n))

            nnest = nnest + 1

            e => n%elements
            do while (associated(e))

!       Define benchmark cost:

              if (outputs) then
                call writeparam('r0_',e%np%index,e%np%d,rec)
		call writegms('revparam',rec,'Benchmark revenue for output '//trim(e%np%f%data)//' in sector '//trim(fnf%data))
              else
                call writeparam('c0_',e%np%index,e%np%d,rec)
		call writegms('costparam',rec,'Benchmark cost for input '//trim(e%np%f%data)//' in sector '//trim(fnf%data))
              endif

              call formv(e%np%qref,'1',qref)
              if (associated(e%np%pref)) then
                call formv(e%np%pref,'1',pref)
                rec = trim(rec)//' = '//trim(qref)//'*'//trim(pref)//';'
              else
                call noparens(qref)
                rec = trim(rec)//' = '//trim(qref)//';'
              end if
	      call writegms('costdef',rec,' ')

              call writeparam('q_',e%np%index,e%np%d,rec)
              rec = trim(rec)//' == '//trim(e%np%qref%data)//';'
	      call writegms('qdef',rec,' ')

!       Define reference price:

              call writeparam('p_',e%np%index,e%np%d,rec)
              rec = trim(rec)//' == '//trim(e%np%f%data)
              if (associated(e%np%t)) then
                rec = trim(rec)//' * (1 '
                tl => e%np%t
                do while (associated(tl))
                  if (associated(tl%t)) rec = trim(rec)//'+'//trim(tl%t%data)
                  if (associated(tl%n)) then
                    if (associated(tl%m)) then
                      rec = trim(rec)//'+'//trim(tl%m%data)//'*'//trim(tl%n%data)
                    else
                      rec = trim(rec)//'+'//trim(tl%n%data)
                    end if
                  end if
                  tl => tl%next
                end do
                rec = trim(rec)//')'
              endif
              if (associated(e%np%pref)) then
                call formv(e%np%pref,'1',pref)
                rec = trim(rec)//'/'//trim(pref)
              endif
	      rec = trim(rec)//';'
	      call writegms('pdef',rec,' ')
              e => e%next
            end do
            call nextnest(n)
            if (.not.associated(n)) then
              if (outputs) exit
              outputs = .true.
              n => fn%outputs
            end if
          end do

          nassigned = 0
          outputs = .false.
	  do while (nassigned < nnest)

!       Locate a nest which is defined:

            n => fn%inputs
            do while (.not.defined(n) .or. n%assigned)
              call nextnest(n)
              if (.not.associated(n)) then
                if (outputs) then
                  n => fn%inputs
                  outputs = .false.
                else
                  n => fn%outputs
                  outputs = .true.
                end if
              endif
            end do
                  
            n%assigned = .true.
            nassigned = nassigned + 1

!       Benchmark revenue and cost for this nest:

            if (outputs) then
              call writeparam('r0_',n%index,fnf%arg,total)
	      call writegms('revparam',trim(total),'Benchmark revenue for output nest '//trim(n%ident)//' in sector '//trim(fnf%data))
            else
              call writeparam('c0_',n%index,fnf%arg,total)
	      call writegms('costparam',trim(total),'Benchmark cost for input nest '//trim(n%ident)//' in sector '//trim(fnf%data))
            endif

!       Costs associated with commodity inputs:

            rec = ' '
            e => n%elements
            do while (associated(e))
              if (outputs) then
                call writeparam('r0_',e%np%index,e%np%d,element)
              else
                call writeparam('c0_',e%np%index,e%np%d,element)
              end if

! TFR bug fix: only include the "+" when rec is nonblank to avoid syntax errors:

	      if (rec.ne.' ') rec = trim(rec)//'+'
              if (associated(e%np%sd)) then
                call writedomain(e%np%sd, domstr)

! TFR bug fix: include the condition applying to the input field.

		if (e%np%f%condtn.ne.' ') domstr = trim(domstr)//'$'//e%np%f%condtn
                rec = trim(rec)//'sum('//trim(domstr)//','//trim(element)//')'
              else
                rec = trim(rec)//trim(element)
              end if
              e => e%next
            end do

!       Costs associated with subnests:

            nl => n%subnests
            do while (associated(nl))
              if (outputs) then
                call writeparam('r0_',nl%n%index,fnf%arg,element)
              else
                call writeparam('c0_',nl%n%index,fnf%arg,element)
              endif
              rec = trim(rec)//' + '//trim(element)
              nl => nl%next
            end do
	    rec = trim(total)//' = '//trim(rec)//';'
	    call writegms('costdef',rec,' ')

!       Value shares for commodity components:

            e => n%elements
            do while (associated(e))
              call writeparam('theta_',e%np%index,e%np%d,rec)
              if (outputs) then
	        call writegms('shareparam',rec,'Benchmark share for output '//trim(e%np%f%data)//' in nest '//trim(n%ident)//' for sector '//trim(fnf%data))
              else
	        call writegms('shareparam',rec,'Benchmark share for input  '//trim(e%np%f%data)//' in nest '//trim(n%ident)//' for sector '//trim(fnf%data))
              endif
              if (outputs) then
                call writeparam('r0_',e%np%index,e%np%d,element)
              else
                call writeparam('c0_',e%np%index,e%np%d,element)
              end if
	      call writegms('sharedef',trim(rec)//' = '//trim(element)//'/'//trim(total)//';',' ')
              e => e%next
            end do

!       Value shares for nest components:

            nl => n%subnests
            do while (associated(nl))
              call writeparam('theta_',nl%n%index,fnf%arg,rec)
              if (outputs) then
		call writegms('shareparam',rec,'Benchmark share for output nest '//trim(nl%n%ident)//' in nest '//trim(n%ident)//' for sector '//trim(fnf%data))
              else
		call writegms('shareparam',rec,'Benchmark share for input nest  '//trim(nl%n%ident)//' in nest '//trim(n%ident)//' for sector '//trim(fnf%data))
              endif
              if (outputs) then
                call writeparam('r0_',nl%n%index,fnf%arg,element)
              else
                call writeparam('c0_',nl%n%index,fnf%arg,element)
              endif
	      call writegms('sharedef',trim(rec)//' = '//trim(element)//'/'//trim(total)//';',' ')
              nl => nl%next
            end do

!       Price index for this nest:

            if (outputs) then
!.              write(iogms,'(a)') '*       Price index for output nest '//trim(n%ident)//' in sector '//trim(fnf%data)//'";'
            else
!.              write(iogms,'(a)') '*       User cost index for input nest '//trim(n%ident)//' in sector '//trim(fnf%data)//'";'
            end if
            call writeparam('p_',n%index,fnf%arg,rec)
	    rec = trim(rec)//' == '
	    if (.not.numeric(n%value)) then
	      rec = trim(rec)//'('
	      call leontief(n,fnf,rec)
	      rec = trim(rec)//')$('//trim(n%value)//'=0) + ('
	      call ces(n,fnf,rec)
	      rec = trim(rec)//'$('//trim(n%value)//'<>1 and '//trim(n%value)//'<>0 ) + ('
	      call cobbdouglas(n,fnf,rec)
	      rec = trim(rec)//'$('//trim(n%value)//'=1)'
	    else
	      read(n%value,*) esub
	      if (esub.le.0.01) then
	        call leontief(n,fnf,rec)
	      else if (abs(esub-1).le.0.01) then
	        call cobbdouglas(n,fnf,rec)
	      else
	        call ces(n,fnf,rec)
	      end if
	    end if
	    rec = trim(rec)//';'
	    call writegms('pdef',rec,' ')
          end do

!       Finally, generate the demand functions for this function:

          nassigned = 0
          outputs = .false.
          prefix = 'd'
          n => fn%inputs
          do while (associated(n))

            call writeparam(prefix//'_',n%index,fnf%arg,quant)
            if (outputs) then
!.              write(iogms,'(a)') '*       Supply index for output nest '//trim(n%ident)//' from sector '//trim(fnf%data)
            else
!.              write(iogms,'(a)') '*       Demand index for input nest '//trim(n%ident)//' into sector '//trim(fnf%data)
            end if
            if (associated(n%parent)) then
              call writeparam(prefix//'_',n%parent%index,fnf%arg,level)
              call writeparam('p_',n%index,fnf%arg,price)
              call writeparam('p_',n%parent%index,fnf%arg,cost)
	      call writegms(prefix,trim(quant)//' == '//trim(level)//'* ('//trim(cost)//'/'//trim(price)//')**'//trim(n%parent%value)//';',' ')
            else
	      call writegms(prefix,trim(quant)//' ==  1;',' ')
            end if

            e => n%elements
            call writeparam('p_',n%index,fnf%arg,cost)
            call writeparam(prefix//'_',n%index,fnf%arg,level)
            do while (associated(e))
              call writeparam('p_',e%np%index,e%np%d,price)
              call writeparam(prefix//'_',e%np%index,e%np%d,quant)
              if (outputs) then
!.                write(iogms,'(a)') '*       Supply index for output '//trim(e%np%f%data)//' in nest '//trim(n%ident)//' from sector '//trim(fnf%data)
              else
!.                write(iogms,'(a)') '*       Demand index for input '//trim(e%np%f%data)//' in nest '//trim(n%ident)//' from sector '//trim(fnf%data)
              end if
	      call writegms(prefix,trim(quant)//' == '//trim(level)//'* ('//trim(cost)//'/'//trim(price)//')**'//trim(n%value)//';',' ')
              e => e%next
            end do

            call nextnest(n)
            if (.not.associated(n) .and. .not.outputs) then
              n => fn%outputs
              outputs = .true.
              prefix = 's'
            end if
          end do
                  
          fn => fn%next
        end do

!       Endowment functions:

        fn => functionlist
        do while (associated(fn))
          fnf => fn%firstrecord%firstfield
          if (fnf%label.ne.'$demand') then
            fn => fn%next
            cycle
          end if
          el => fn%endowments
          do while (associated(el))
            call writeparam('e_',el%e%index,el%e%d,endow)
	    call writegms('e',trim(endow)//' == '//trim(el%e%q%data)//';',' ')
            el => el%next
          end do
          fn => fn%next
        end do

        return
        end subroutine functions


	subroutine cobbdouglas(n,fnf,rec)
        type (nest), pointer :: n
        type (field), pointer :: fnf
	character (len=*) :: rec
	character (len=255) :: price, share, domstr
        type (netputlist), pointer :: e
        type (nestlist), pointer :: nl
	character :: prefix

	e => n%elements
	prefix = ' '
	do while (associated(e))
	  call writeparam('theta_',e%np%index,e%np%d,share)
	  call writeparam('p_',e%np%index,e%np%d,price)
	  if (associated(e%np%sd)) then
	    call writedomain(e%np%sd, domstr)
	    rec = trim(rec)//prefix//'prod('//trim(domstr)//','//trim(price)//'**'//trim(share)//')'
	    prefix = '*'
	  else
	    rec = trim(rec)//prefix//trim(price)//'**'//trim(share)
	    prefix = '*'
	  end if
	  e => e%next
	end do
	nl => n%subnests
	do while (associated(nl))
	  call writeparam('theta_',nl%n%index,fnf%arg,share)
	  call writeparam('p_',nl%n%index,fnf%arg,price)
	  rec = trim(rec)//prefix//trim(price)//'**'//trim(share)
	  prefix = '*'
	  nl => nl%next
	end do
	return
	end subroutine cobbdouglas

	subroutine ces(n,fnf,rec)
	type (nest), pointer :: n
        type (field), pointer :: fnf
	character (len=*) :: rec
        character (len=1) :: prefix
        type (netputlist), pointer :: e
	character (len=255) :: domstr, share, price
        type (nestlist), pointer :: nl

	e => n%elements
	prefix = ' '
	do while (associated(e))
	  call writeparam('theta_',e%np%index,e%np%d,share)
	  call writeparam('p_',e%np%index,e%np%d,price)
	  if (associated(e%np%sd)) then
	    call writedomain(e%np%sd, domstr)
	    rec = trim(rec)//prefix//'sum('//trim(domstr)//','//trim(share)//' * '//trim(price)//'**(1-'//trim(n%value)//'))'
	    prefix = ' '
	  else
	    rec = trim(rec)//prefix//trim(share)//'*'//trim(price)//'**(1-'//trim(n%value)//')'
	    prefix = ' '
	  end if
	  e => e%next
	end do
	nl => n%subnests
	do while (associated(nl))
	  call writeparam('theta_',nl%n%index,fnf%arg,share)
	  call writeparam('p_',nl%n%index,fnf%arg,price)
	  rec = trim(rec)//prefix//trim(share)//'*'//trim(price)//'**(1-'//trim(n%value)//')'
	  prefix = ' '
	  nl => nl%next
	end do
	return

	end subroutine ces

	subroutine leontief(n,fnf,rec)
	type (nest), pointer :: n
        type (field), pointer :: fnf
	character (len=*) :: rec
        character (len=1) :: prefix
        type (netputlist), pointer :: e
        type (nestlist), pointer :: nl
	character (len=255) :: domstr, share, price
	prefix = ' '
	e => n%elements
	do while (associated(e))
	  call writeparam('theta_',e%np%index,e%np%d,share)
	  call writeparam('p_',e%np%index,e%np%d,price)
	  if (associated(e%np%sd)) then
	    call writedomain(e%np%sd, domstr)
	    rec = trim(rec)//prefix//'sum('//trim(domstr)//','//trim(share)//' * '//trim(price)//')'
	    prefix = '+'
	  else
	    rec = trim(rec)//prefix//trim(share)//'*'//trim(price)
	    prefix = '+'            
	  end if
	  e => e%next
	end do

	nl => n%subnests
	do while (associated(nl))
	  call writeparam('theta_',nl%n%index,fnf%arg,share)
	  call writeparam('p_',nl%n%index,fnf%arg,price)
	  rec = trim(rec)//prefix//trim(share)//'*'//trim(price)
	  prefix = '+'
	  nl => nl%next
	end do
	return
	end subroutine leontief

        logical function defined(n)
        type (nest), pointer :: n
        type (nestlist), pointer :: nl
        nl => n%subnests
        do while (associated(nl))
          if (.not.nl%n%assigned) then
            defined = .false.
            return
          endif
          nl => nl%next
        end do
        defined = .true.
        return
        end function defined


        subroutine formv(f,default,value)
        type (field), pointer :: f
        character (len=*), intent(in) :: default
        character (len=*), intent(out) ::  value
        if (associated(f)) then
          value = '('//trim(f%data)//')'
          if (f%condtn.ne.' ') &
            value = '('//trim(value)//'$'//trim(f%condtn)//' + '//trim(default)//'$( not('//trim(f%condtn)//')))'
        else
          value = trim(default)
        endif
        return
        end subroutine formv

        subroutine noparens(value)
        character (len=*) :: value
        integer nc
        value = adjustl(value)
        nc = len_trim(value)
        if (value(1:1).eq.'(' .and. value(nc:nc).eq.')') value = value(2:nc-1)
        return
        end subroutine noparens

	subroutine writemodel

	write(iogms,'(/a/)') '*   Alert the user to undefined sets or parameters which are referenced in the MPSGE model:'
	call writetype(iogms,0,'$abort')

	write(iogms,'(/a/)') '*    Define aliases for sets:'
	call writetype(iogms,0,'alias')

	write(iogms,'(/a/)') '*    Benchmark costs and value shares:'
	write(iogms,'(a)') 'PARAMETER'

	write(iogms,'(/a/)') '*    Benchmark costs:'
	call writetype(iogms,8,'costparam') 

	write(iogms,'(/a/)') '*    Benchmark revenue:'
	call writetype(iogms,8,'revparam') 

	write(iogms,'(/a/)') '*    Benchmark shares:'
	call writetype(iogms,8,'shareparam') 
	write(iogms,'(a//)') ';'

	write(iogms,'(/a/)') '*   Invoke the function preprocessor'
	write(iogms,'(/a/)') '$sysinclude gams-f'

	call writetype(iogms,0,'costdef')
	call writetype(iogms,0,'sharedef')

	write(iogms,'(/a/)') '*   Cost functions'
	call writetype(iogms,0,'pdef')

	write(iogms,'(/a/)') '*   Quantity functions'
	call writetype(iogms,0,'qdef')

	write(iogms,'(/a/)') '*   Compensated demand indices:'
	call writetype(iogms,0,'d')

	write(iogms,'(/a/)') '*   Compensated supply indices:'
	call writetype(iogms,0,'s')

	write(iogms,'(/a/)') '*   Endowments:'
	call writetype(iogms,0,'e')

        write(iogms,'(//a)') 'POSITIVE VARIABLES'
	call writetype(iogms,8,'variable')

        write(iogms,'(//a)') 'EQUATIONS'
	call writetype(iogms,8,'equation')

	write(iogms,'(//)') 
	call writetype(iogms,0,'model')

        write(iogms,'(/a)') '*     Level value assignments'
	call writetype(iogms,0,'level')

        write(iogms,'(/a)') '*     Zero profit conditions'
	call writetype(iogms,0,'profit')

        write(iogms,'(/a)') '*     Market clearance conditions'
	call writetype(iogms,0,'market')

        write(iogms,'(/a)') '*     Income definitions'
	call writetype(iogms,0,'income')

        write(iogms,'(/a)') '*     Auxiliary constraints:'
	call writetype(iogms,0,'constraint')

	return
	end subroutine writemodel

	subroutine RewriteMGEFile
! Rewrite MGE file to split nests
! [17/04/04] This routine added by KP since this procedure is
!  currently called twice in the main program

!         Generate indices for all the nests and netputs:

	if(log) write(*,'(a)') ' calling indices'
	call indices

! [17/04/04] Added thanks to Tom R email

	if(log) write(*,'(a)') ' calling functions'
	call functions

	if(log) write(*,'(a)') ' calling rewritemodel'
	call rewritemodel

	end subroutine RewriteMGEFile

	end module mpsgms

